' Sample 17.3: 
' 
'主程序
Sub Main

	Call Pick  '调用Pick子程序，该子程序用于识别顶层和底层的元件布局层。
	call BOM  '调用BOM子程序，虽然BOM子程序的具体内容没有给出，但通常用于生成或处理物料清单(Bill of Materials)
	StatusBarText = "The export is complete"  '设置状态栏文本，通知用户导出已完成
	MsgBox "The export is complete" , vbOkOnly , "Prompt" '弹出消息框，显示“导出已完成”，只提供“确定”按钮，并设置标题为“Prompt”
End Sub

Sub Pick  '子程序 
    '初始化两个变量,分别表示顶层和底层 
	Dim ComponentLayerTypeTop
	Dim ComponentLayerTypeBOT
	ComponentLayerTypeTop = -1   '表示元件布局层编号尚未找到
	ComponentLayerTypeBOT  = -1
	
	
	For Each slayer In ActiveDocument.Layers  '遍历当前文档(ActiveDocument)中的所有图层(Layers)
        '获取每个图层的类型(sLayerType)和编号(sLayerNumber)
		Dim sLayerType 
		Dim sLayerNumber 	
        
		sLayerType = slayer.Type
		sLayerNumber = slayer.Number
		'如果图层类型为元件布局层(ppcbLayerComponent)，则按顺序赋值给 ComponentLayerTypeTop 和 ComponentLayerTypeBOT，分别代表顶层和底层的布局层
		If sLayerType = ppcbLayerComponent  Then
			If ComponentLayerTypeTop = -1   Then
				
				ComponentLayerTypeTop = sLayerNumber
				
			ElseIf  ComponentLayerTypeBOT = -1   Then
			
				ComponentLayerTypeBOT  = sLayerNumber
				
			End If		
		End If
	Next slayer
	
	
    '这里定义了一个常量数组Columns，包含了表头的各个列名，意味着这个表格是用来记录电子元件设计的相关信息，比如部件标识符(Designator)、焊盘封装(Footprint)、中心X坐标(Mid X)等
	Const Columns = Array("Designator",	"Footprint",	"Mid X",	"Mid Y",	"Ref X",	"Ref Y",	"Pad X",	"Pad Y",	"Layer",	"Rotation",	"Comment",	"SMD")',"Pins","SMD", "Glued")
	tempFile = DefaultFilePath & "\temp.txt"  '设置了一个临时文件的路径，文件名为temp.txt，位于默认的文件路径下
	Open tempFile For Output As #1  '使用Open语句打开了之前定义的tempFile文件，准备向其中写入数据。#1是一个文件号，用来标识这个打开的文件。
    
    '通过循环遍历Columns数组，并调用OutCell过程（虽然这里没给出具体实现，但根据名称推测是用来输出单元格内容到文件的）来输出每列的标题，之后打印换行
	'Output table header
	For i = 0 to UBound(Columns)
		OutCell Columns(i)
	Next
	Print #1
	'Output table rows
	'
		OutCell ""       
		OutCell ""
		OutCell ""
		OutCell ""
		
		OutCell ""
		OutCell ""
		
		OutCell ""
		OutCell ""	
		
		OutCell ""
		OutCell ""
		OutCell ""	
		Print #1
		
	part_Count = ActiveDocument.Components.Count   '获取当前设计文档中的组件总数
	ActiveDocument.unit = ppcbUnitMetric   '设置单位为公制，确保后续的测量值统一为毫米
	
	
	now_Count = 0   
	For Each part in ActiveDocument.Components   '循环，遍历每一个组件
		if part.Pins.Count > 1 then
			OutCell part.Name        
			OutCell part.Decal
			
			Dim centerX  As Single
			Dim centerY  As Single
			Dim cout  As Integer
			centerX = 0.0
			centerY = 0.0
			cout = 0

			Dim IsSMD As Boolean
			IsSMD = False
			
			For Each nextCompPin In part.Pins
				centerX = centerX+nextCompPin.PositionX 
				centerY = centerY+nextCompPin.PositionY 
				''元器件是否为SMD属性遇上个别焊盘上有孔时会输出错误, 这里遍历每个引脚. 只要有一个引脚是SMD,则元器件就是SMD类型
				If	nextCompPin.IsSMD Then
					IsSMD = True
				End If

			Next nextCompPin
			'centerPositionX = Format$(centerX/(part.Pins.Count), "#.00")
			'centerPositionY = Format$(centerY/(part.Pins.Count), "#.00")
            '对于X轴 (centerX)，如果它的值不为0，则计算所有引脚（Pins）的平均位置（即centerX/part.Pins.Count），然后以带有三位小数和"mm"单位的格式输出
			If centerX <> 0 Then
				OutCell Format( centerX/(part.Pins.Count) , "0.000") &"mm"
			Else
            '如果centerX确实为0，则直接输出其原始值，同样格式化为带有三位小数和"mm"的字符串
				OutCell Format( centerX, "0.000") &"mm"
			End If
			'对于Y轴 (centerY) 的处理逻辑与X轴相同
			If centerY <> 0 Then
				OutCell Format( centerY/(part.Pins.Count), "0.000") &"mm"
			Else
				OutCell Format( centerY, "0.000") &"mm"
			End If
					
			'OutCell Format(part.PositionX, "0.000")
			'OutCell Format(part.PositionY, "0.000")
			
			OutCell Format(part.PositionX, "0.000") &"mm"
			OutCell Format(part.PositionY, "0.000") &"mm"

'下面这一行试图从当前激活的文档(ActiveDocument)中获取名为part.Name & ".1"的引脚对象，并将其赋值给变量pin_1。这里.1通常表示部件的第一个引脚，
'而part.Name则是动态引用部件的名称，因此整段part.Name & ".1"是用来唯一标识某个部件的第一个引脚
			Set pin_1 = ActiveDocument.Pins( part.Name & ".1")
			'检查变量pin_1是否为Nothing。如果之前尝试获取引脚失败（即该引脚不存在），则pin_1会被设置为Nothing
			If pin_1 Is Nothing Then
				OutCell ""  '如果pin_1是Nothing，则这两行会连续输出两个空单元格。这可能是为了在输出报告或表格时保持格式的一致性，即使没有找到该引脚信息
				OutCell ""		
			Else
            '如果pin_1不为Nothing，即成功找到了部件的第一个引脚，则这两行会分别以带有三位小数和"mm"单位的格式输出该引脚的X轴和Y轴坐标。
            '这里直接再次访问了pin_1的坐标属性，尽管之前已经赋值给了pin_1，这种写法是冗余的，但不影响结果
				OutCell Format(ActiveDocument.Pins( part.Name  & ".1").PositionX, "0.000") &"mm"
				OutCell Format(ActiveDocument.Pins( part.Name  & ".1").PositionY, "0.000") &"mm"	
			End If
			
			Dim partLayerName As String	 '定义了一个字符串类型的变量partLayerName，用于存储部件所在的层名称的简写
			'通过ActiveDocument.LayerName方法获取部件part所在层的完整名称，并将其赋值给partLayerName变量
			partLayerName =  ActiveDocument.LayerName(part.layer)
			'如果层名称是"TopLayer"或"Top"，则将其简化为"T"
			If partLayerName = "TopLayer" Or partLayerName = "Top" Then
				partLayerName = "T"	
            '如果层名称是"Botlayer"、"Bot"或"Bottom"，则简化为"B"
			ElseIf  partLayerName = "Botlayer" Or partLayerName = "Bot"  Or partLayerName = "Bottom" Then
				partLayerName = "B"	
			'如果部件位于顶层（由ComponentLayerTypeTop表示），并且ComponentLayerTypeTop和ComponentLayerTypeBOT都被正确定义（不等于-1），则层名称简化为"T"
            ElseIf part.layer = ComponentLayerTypeTop  And ComponentLayerTypeTop<> -1 And ComponentLayerTypeBOT<> -1 Then
				partLayerName = "T"
			'如果部件位于底层（由ComponentLayerTypeBOT表示），且两层类型都被正确定义，则层名称简化为"B"
            ElseIf  part.layer = ComponentLayerTypeBOT And ComponentLayerTypeBOT<> -1 And ComponentLayerTypeTop<> -1 Then		
				partLayerName = "B"		
			Else
            '如果上述条件都不满足，说明层名称既不符合常见的顶层/底层命名，也没有匹配到预定义的组件层类型，这时将层名称简化为不确定的"T or B??"
			    partLayerName = "T or B??" 
			End If
			
			OutCell partLayerName  '输出之前定义好的partLayerName变量，即部件所在的简化层名称（"T"或"B"）
			
			If partLayerName = "B" Then	
				 Dim Orientation
				 Orientation = 0
                 '计算部件的方向角度，先转换为逆时针方向（Orientation = 360 - part.Orientation），然后镜像处理（减去180度）
				 Orientation = 360 - part.Orientation  ''Convert to counterclockwise
				 Orientation = Orientation - 180       ''Mirror			     			     
				 If Orientation<0 Then  '保角度为正值（如果计算后角度小于0，则加上360度）
					Orientation = Orientation + 360	   'Turn positive		        
				 End If
				 OutCell Format(Orientation,"0.00")  '使用OutCell输出调整后的角度，格式化为保留两位小数
			Else
				OutCell Format(part.Orientation,"0.00") '如果部件不在底层：直接输出部件的原始方向角度，同样格式化为两位小数
			End If
			'检查部件是否有注释（"Comment"），如果有则输出
			if AttrVal(part, "Comment")	<> "" then
				OutCell AttrVal(part, "Comment")
			ElseIf	 AttrVal(part, "Value")	<> "" Then  '否则，检查部件是否有值（"Value"），如果有则输出
				OutCell AttrVal(part, "Value")
			Else
				OutCell part.PartType   '如果上述两者都为空，则输出部件类型（part.PartType）
			End If		
					
			OutCell Format(IsSMD, "True/False")  '输出部件是否为表面贴装器件（SMD），格式为"True"或"False"

			'OutCell part.Pins.Count
			'OutCell Format(part.IsSMD, "Yes/No")
			'OutCell Format(part.Glued, "Yes/No")
			

			
			Print #1  '相关计数逻辑,打印到文件句柄#1，这通常意味着将累积的信息写入一个文件中,
		End If
		now_Count = now_Count + 1		'更新并显示状态栏信息，显示当前处理的部件名称、已处理部件的数量及总部件数量
		StatusBarText = "Pick:"& part.Name    &" "& now_Count &"/"&  part_Count		
	Next part

	Close #1  
    '调用ExportToExcel函数，将收集到的数据导出到Excel文件中，文件名基于PCB设计文档的全名，并添加特定后缀
	Call ExportToExcel( ActiveDocument.FullName, "Pick Place for  ") 

End Sub

Sub BOM
'定义了一个数组，包含了要输出的列标题，比如注释、描述、标识符等
	Const Columns = Array("Comment", "Description", "Designator", "Footprint", "LibRef", "Pins", "SMD", "Quantity")
	Dim part_Count As Integer
	Dim IsSMD As Boolean
	IsSMD = False

	part_Count = 0 'ActiveDocument.Components.Count
	'统计具有多于一个引脚的部件数量。每次符合条件的部件被计数
	For Each part In ActiveDocument.Components
		if part.Pins.Count > 1 then
			part_Count = part_Count + 1
		end if
		
	Next part	
	ReDim Parts(part_Count, 14) As String '为存储所有部件信息的二维数组分配空间。数组的每个元素对应一个部件的一条记录和其多个属性

	tempFile = DefaultFilePath & "\temp.txt"   '创建临时文件,定义了输出文件的路径
	Open tempFile For Output As #1  '打开这个文件以供写入

	'Output table header输出表头到文件,通过一个循环遍历 Columns 数组，并对每个元素调用 OutCell 函数来输出列标题到文件，之后打印换行
	For i = 0 to UBound(Columns)
		OutCell Columns(i)
	Next
	Print #1
	'Output table rows
	'但这里出现了一段示例性的空白输出，实际上应遍历部件并填充实际数据到 Parts 数组，然后输出到文件中。当前的代码只输出了空字符串，这可能是为了演示格式或预留位置
		OutCell ""       
		OutCell ""
		OutCell ""
		
		OutCell ""
		OutCell ""
		OutCell ""
		OutCell ""
		OutCell ""	
		Print #1
		
	ActiveDocument.unit = ppcbUnitMetric
	
	intI = 	1
	now_Count = 0
	
	For Each part In ActiveDocument.Components '继续循环遍历电路板设计文档中的每一个部件
'确保只有引脚数量超过1的部件才会被处理。这通常意味着在处理多引脚的部件，可能为了忽略无引脚或单引脚的项如贴片电阻、电容等
		if part.Pins.Count > 1 then
			Dim Comment_s As String  ' 定义一个字符串变量来储存部件的注释信息
			IsSMD = False '再次初始化SMD标志为假，确保每次处理新部件时该状态重置
'获取部件注释信息: 使用 AttrVal(part, "Comment") 和 AttrVal(part, "Value") 尝试获取部件的注释或值作为Comment_s，如果两者都为空，则默认使用部件类型(part.PartType)
			if AttrVal(part, "Comment")	<> "" then
				Comment_s = AttrVal(part, "Comment")
			ElseIf	 AttrVal(part, "Value")	<> "" Then
				Comment_s = AttrVal(part, "Value")
			Else
				Comment_s = part.PartType
			End If
'判断是否为SMD元件: 通过内部循环 For Each nextCompPin In part.Pins 检查部件的每个引脚(pin)，一旦发现引脚标记为SMD(nextCompPin.IsSMD 为真)，则将 IsSMD 设为真并跳出循环
			For Each nextCompPin In part.Pins
				''元器件是否为SMD属性遇上个别焊盘上有孔时会输出错误, 这里遍历每个引脚. 只要有一个引脚是SMD,则元器件就是SMD类型
				If	nextCompPin.IsSMD Then
					IsSMD = True
					Exit For
				End If

			Next nextCompPin
'根据获取的数据填充二维数组Parts的当前行，包括部件类型、注释、描述、名称、封装、供应商零件号、引脚数以及是否为SMD的信息，并且每处理完一个有效部件就递增行索引intI
			Parts(intI,1) = part.PartType
			Parts(intI,2) = Comment_s
			Parts(intI,3) = AttrVal(part, "Description")
			Parts(intI,4) = part.Name 
			Parts(intI,5) = part.Decal
			Parts(intI,6) = AttrVal(part, "SuppliersPartNumber")
			Parts(intI,7) = part.Pins.Count
			Parts(intI,8) = Format(IsSMD, "True/False")
			intI  = intI + 1


		end if
		now_Count = now_Count + 1 '记录当前处理的部件总数，并通过StatusBarText更新状态栏文本，显示类似于“BOM:部件名称 当前数量/总数量”的信息
		StatusBarText = "BOM:"& part.Name    &" "& now_Count &"/"&  part_Count			
	Next part '结束对ActiveDocument.Components中所有部件的遍历
	
	Dim comp_counter As Integer
	Dim Species As Integer
	Const search_flag As Integer = 9
	
	Dim Component As String
	Dim Component_temp  As String
	Dim label As String 
	
	comp_counter = 0
    Species = 0
'初始化一个循环，遍历数组Parts的第一维，其中UBound(Parts, 1)返回Parts数组第一维度的最大下标
    For i = 1 To UBound(Parts, 1)  '标记物料属性形同    
        If Parts(i, search_flag) = "" Then  '是否已经查找过,判断当前行是否已被标记为已查找。如果search_flag列为空（即字符串""），则表示尚未处理该行
        ''通过连接Parts数组中的多个列值，创建一个独特的字符串来代表零件的组合属性      
            Component = Parts(i, 1) & Parts(i, 2)  & Parts(i, 3)  & Parts(i, 5)   & Parts(i, 6)   & Parts(i, 7)   & Parts(i, 8)              
            label = Parts(i, 4) '标号,获取当前行的标号
            
            comp_counter = 1            
            For j = i + 1 To UBound(Parts, 1) '开始第二个循环，从当前行的下一行开始，目的是与之后的行进行比较
                Component_temp =  Parts(j, 1) & Parts(j, 2)  & Parts(j, 3)  & Parts(j, 5)   & Parts(j, 6)    & Parts(j, 7)    & Parts(j, 8)       
                
                If Component = Component_temp Then   '比较当前行(i)的组件标识符与后续行(j)的组件标识符是否相同             
                    comp_counter = comp_counter + 1  '如果匹配，则增加计数器comp_counter，并将匹配行的标号添加到label中，同时标记这些行已处理
                    label = label & ", " & Parts(j, 4)      '标号，此行双引号里", "逗号后的空格决定输出表格里两个位号间逗号后也有一个空格，如果不需要可删除
                    Parts(j, search_flag) = "0"            '标记为已经查找过
                    Parts(j, search_flag + 1) = Str(i)     '标记在那一行找到的
					'200个位号每行,当收集到的相同属性零件达到200个时，提前结束内部循环，优化性能
					if comp_counter >= 200	then
						Exit For
					End If
                End If                
            Next j
            '使用search_flag + 2和search_flag + 3列分别存储汇总的标号和数量
            Parts(i, search_flag + 2) = label '用料标号
            Parts(i, search_flag + 3) = Str(comp_counter) '用料数量

            Species = Species + 1  '物种计数
        End If
    Next i


    '填入物料
    Dim NO_ As Integer '定义了一个整数变量NO_，用来作为数组SpeciesArray的索引
    ReDim SpeciesArray(Species, 8)  '初始化一个多维数组SpeciesArray，第一维度大小由变量前面Species的累加决定，第二维度固定为8，用于存储不同属性的数据
    
    NO_ = 1  
    For i = 1 To UBound(Parts, 1) '标记物料属性形同， 遍历Parts数组的每一行，Parts数组可能包含了所有物料的信息
        If Parts(i, search_flag) = "" Then  '是否已经查找过, 检查当前行的指定列（由search_flag决定）是否为空，如果是，则表示这部分数据还未被处理
        	’接下来的一系列赋值语句将Parts数组中对应位置的值分别存入SpeciesArray的各个列中
            SpeciesArray(NO_, 1) = Parts(i, 2)                   'Value
        	SpeciesArray(NO_, 2) = Parts(i, 3)                   'Description
        	SpeciesArray(NO_, 3) = Parts(i, search_flag + 2)     'Designator
        	SpeciesArray(NO_, 4) = Parts(i, 5)                   'Footprint
        	SpeciesArray(NO_, 5) = Parts(i, 6)                   'LibRef",
        	SpeciesArray(NO_, 6) = Parts(i, 7)                   'Pins
			SpeciesArray(NO_, 7) = Parts(i, 8)                   'SMD
        	SpeciesArray(NO_, 8) = Parts(i, search_flag + 3)     'Quantity   

            NO_ = NO_ + 1 '每次找到符合条件的数据行，就将NO_加1，这样NO_作为SpeciesArray的行索引，保证每次新数据都添加到数组的新一行
        End If
    Next i
    '用于遍历并输出SpeciesArray中的所有数据到一个外部文件（通过Print #1指令，#1是一个文件号，表明之前已通过Open语句打开了一个文件）
	For i = 1 To UBound(SpeciesArray, 1) 
		For j =1 To 8
			OutCell SpeciesArray(i,j) 		
		Next j
		Print #1	
	Next i

	Close #1
'这行调用了ExportToExcel子程序，参数1是当前文档的全路径名，参数2是新Excel文件的命名前缀，意味着会将处理后的数据导出到一个新的Excel文件，文件名为“BOM for ”
	Call ExportToExcel( ActiveDocument.FullName  ,"BOM for ")


End Sub



Sub ExportToExcel (txt As String, FileType As String)
	FillClipboard  '用来填充剪贴板的内容，可能是从当前活动的应用程序中复制数据
	Dim xl As Object	
	Dim Path As String
	Dim FileName As String
	' 代码首先尝试通过GetObject获取一个已经打开的Excel应用程序实例。如果获取失败（即xl Is Nothing为True），
    '则通过CreateObject新建一个Excel应用程序实例，并设置其可见性为True
	Path = ParsePath(txt)
	FileName = GetFileNameNoExt(txt)

	On Error Resume Next
	Set xl =  GetObject(,"Excel.Application")
	On Error GoTo ExcelError	' Enable error trapping.	
	If xl Is Nothing Then
		Set xl =  CreateObject("Excel.Application")
	End If
	xl.Visible = True
	xl.Workbooks.Add
    '对Excel工作表的"A:L"列应用文本格式（NumberFormat = "@"），确保粘贴时不进行数字格式转换。特别地，
    '对第一行"A1:L1"设置加粗和文本格式，可能为了突出标题
	xl.Range("A:L").NumberFormat = "@" '
	xl.Range("A1:L1").NumberFormat = "@"
	xl.Range("A1:L1").Font.Bold = True
    xl.Range("A1:L1").Font.Name = "宋体"  '原代码里没有，尝试看看设置后是否能解决中文乱码的问题
	xl.Range("A1:L1").NumberFormat = "@"	
	xl.ActiveSheet.Paste  '使用ActiveSheet.Paste将剪贴板内容粘贴到Excel的当前活动工作表中
	'xl.ActiveSheet.UsedRange.Columns.AutoFit
	If StrComp("BOM for ",FileType) = 0 Then '如果FileType参数等于"BOM for "，则会给特定的单元格添加描述性批注，这可能是为了标注列的含义
		xl.ActiveSheet.Range("A1").AddComment("This is Comment or Value or PartType")
		xl.ActiveSheet.Range("C1").AddComment("This is Name")
		xl.ActiveSheet.Range("D1").AddComment("This is Decal")
		xl.ActiveSheet.Range("E1").AddComment("This is SuppliersPartNumber")
	End If
	
	
	xl.Range("A1").Select
	xl.Application.DisplayAlerts = False
    'MsgBox xl.Version    
    '根据提供的路径Path、文件类型FileType和文件名（不带扩展名的FileName），以.xls格式保存文件。
    '这里使用的保存格式编号56对应的是Excel 97-2003的二进制文件格式
	xl.activeworkbook.SaveAs(Path & FileType &FileName &".xls" ,56)
	
	''xl.workbooks.close
	''xl.Quit
'代码中使用了简单的错误处理机制，通过On Error Resume Next和On Error GoTo ExcelError来控制错误流。
'在操作完成后，关闭了警告提示以避免保存时的确认对话框，并注释掉了关闭工作簿和退出Excel的代码    
    
	On Error GoTo 0 ' Disable error trapping. 
	Exit Sub    

'当在ExportToExcel过程中遇到错误时，程序会跳转到这里
'使用MsgBox显示错误描述（Err.Description），并设置图标为警告（vbExclamation），标题为"Error Running Excel"，以便用户了解发生了什么错误
ExcelError:
	MsgBox Err.Description, vbExclamation, "Error Running Excel"
	On Error GoTo 0 ' Disable error trapping.  '通过On Error GoTo 0禁用当前的错误处理，恢复默认的错误处理行为，这是在退出子程序之前的好习惯  
	Exit Sub
End Sub

'这个子程序似乎是用来向某个输出（比如一个文件或日志）打印文本内容。它接收一个字符串参数txt，并在其后添加制表符（vbTab），这通常用于组织列式数据
Sub OutCell (txt As String)
	Print #1, txt; vbTab;
End Sub

'此子程序负责将一个临时文件（位于DefaultFilePath & "\temp.txt"）的内容加载到一个字符串变量AllData$中，然后将这个字符串复制到系统剪贴板上
Sub FillClipboard
	' Load whole file to string variable    
    '首先打开指定的临时文件读取所有内容，使用LOF(1)获取文件长度，Input$(L, 1)读取整个文件内容
	tempFile = DefaultFilePath & "\temp.txt"
	Open tempFile  For Input As #1
	L = LOF(1)
	AllData$ = Input$(L,1)
	Close #1 '文件操作结束后，使用Close #1关闭文件
	'Copy whole data to clipboard
	Clipboard AllData$ 
	Kill tempFile '利用Kill tempFile删除临时文件，暗示该过程可能是先将数据写入临时文件，再从临时文件读取并准备复制
End Sub

'定义了一个名为 AttrVal 的函数，它接受两个参数：一个对象 obj 和一个字符串 nm。这个函数的目的是从给定对象的属性集合中获取指定名称 nm 的属性值
'这里声明了一个返回类型为Varint的函数 AttrVal，它接受两个参数：obj 类型为 Object，意味着它可以是任何类型的对象；nm 类型为 String，表示属性的名称
Function AttrVal (obj As Object, nm As String)
'IIf 是 VBA 中的立即求值的条件函数，它接受三个参数：条件表达式、当条件为真时的结果、当条件为假时的结果
'条件表达式为 obj.Attributes(nm) Is Nothing，检查对象 obj 的属性集合中是否存在名为 nm 的属性。如果该属性不存在（即为 Nothing），则条件为真
'当条件为真时，函数返回空字符串 ""，表示没有找到该属性
'当条件为假，即找到了属性 nm，则返回该属性的值 obj.Attributes(nm)
	AttrVal = IIf(obj.Attributes(nm) Is Nothing, "", obj.Attributes(nm))
End Function


'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
'此函数从字符串中分离出路径
Function ParsePath(sPathIn As String) As String
    Dim I As Integer
    For I = Len(sPathIn) To 1 Step -1
    If InStr(":\", Mid$(sPathIn, I, 1)) Then Exit For
    Next
   
    ParsePath = Left$(sPathIn, I)
End Function
'此函数从字符串中分离出文件名
Function ParseFileName(sFileIn As String) As String
    Dim I As Integer
    For I = Len(sFileIn) To 1 Step -1
    If InStr("\", Mid$(sFileIn, I, 1)) Then Exit For
    Next
    ParseFileName = Mid$(sFileIn, I + 1, Len(sFileIn) - I)
    End Function
'此函数从字符串中分离出文件扩展名
Function GetFileExt(sFileName As String) As String
    Dim P As Integer
    For P = Len(sFileName) To 1 Step -1
    If InStr(".", Mid$(sFileName, P, 1)) Then Exit For
    Next
    GetFileExt = Right$(sFileName, Len(sFileName) - P)
End Function
'===========获取文件名但不包括扩展名  aaa
Public Function GetFileNameNoExt(FilePathFileName As String) As String  '获取文件名但不包括扩展名  aaa
    On Error Resume Next
    Dim i As Integer, J As Integer, k As Integer
    i = Len(FilePathFileName)
    J = InStrRev(FilePathFileName, "\")
    k = InStrRev(FilePathFileName, ".")
     If k = 0 Then
        GetFileNameNoExt = Mid(FilePathFileName, J + 1, i - J)
    Else
       GetFileNameNoExt = Mid(FilePathFileName, J + 1, k - J - 1)
    End If
 
End Function
